perm filename CODE4.F4[P11,LCS]2 blob
sn#579538 filedate 1981-04-17 generic text, type T, neo UTF8
C****** CODE4.F4 DRAWS LINES, DASHES, ETC. *******
C TITLE ITMSUB
C INTERNAL ITMSUB
C EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
C EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,OLDTOP
C DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
C DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
C DEFINE J7 <.COMM.+=28 >
SUBROUTINE ITMSUB
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS,OLDY
COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
C RDBR IS SPACER FOR DBL BAR.
RST7=RSTJ2*7.
RST18=RSTJ2*18.
C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
R3Q=R3
C NEXT DRAWS STRAIGHT LINES
RD=R4*RST7
RA=0
RX=RTF*RSTJ2+POS
J10=J10*DIS*RSTJ2
C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
IF(J5.NE.50.AND.J5.NE.150)GO TO 300
C 150 IS FOR 'PARTS' FEATURE - PUTS CRESC. IN ALL.
CALL CRESC
RETURN
300 DBR=0
IF(R6.NE.0)GO TO 401
IF(J7.NE.0)GO TO 401
C FOR BAR LINES
JA=44
C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
CC DBR=0
IF(J4.LT.1000)GO TO 400
C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
DBR=J4/1000
J4=J4-DBR*1000
C NOW J4 HAS 3 DIGITS, 1ST=THICKNESS, 3RD=NUMB. OF STAVES UP.
IF(J5.NE.0)GO TO 9400
IF(DBR.LT.2)GO TO 9400
J5=1
IF(DBR.EQ.4)DBR=1
C FOR REPEAT DBL.BAR WITH P5=0
C P4=2000=DOTS ON RIGHT, =3000=BOTH SIDES
C =4000=DOTS ON LEFT
C DBR=1 HEAVY BAR IS ON RT
9400 RD=RDBR+RDBR*RSTJ2
C TO SPACE THIN BAR FROM HEAVY
IF(J5.EQ.0)GO TO 400
C NEXT ADDS REPEAT DOTS TO DBL BAR.
CALL RPDOT
GO TO 5400
400 IF(J5.NE.0)GO TO 9400
K=J4/100
C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
J7=K*DIS
C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
C5400 L=MOD(J4,100)
C IF(J4.LT.0)J4=0
C ABOVE FOR INVIS. BARS (AT PRINT TIME)
5400 L=J4
IF(L.LT.0)L=0
L=MOD(L,100)
IF(L.NE.0)L=L-1
L=L+J2
C L=L+J2-1
C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
RA=RTF
IF(L.LE.7)GO TO 2400
L=7
RA=300.
C FOR EXTENDING BARS ABOVE STAFF 7
2400 OLDY=RSTFAC(L)
C SAVE IT FOR DBL RPT BAR.
RZ=R3Q
OLDY=STFF(L)+(RA+56.)*OLDY
1400 RA=1
IF(PLT.GE.0)GO TO 140
IF(J4.LT.0)RETURN
J7=J7+1
C DON'T PRINT INVIS BARS. (USED BY 'PAGE')
RA=XDIS
C BAR LINES PLOT AS DOUBLE THICKNESS
140 RJX=R3Q
42 CALL LINES(R3Q,RX,3)
RJ=-1.
RW=OLDY
406 CALL LINES(RJX,OLDY,2)
IF(J10.EQ.0)GO TO 411
C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
J7=J10
J10=0
RA=XDIS
411 IF(J7.LE.0)GO TO 409
CALL HEAVY
GO TO 42
409 IF(DBR.LE.0)RETURN
OLDY=RW
RA=RZ-RD
IF(DBR.NE.1)RA=RJX+RD-1.
R3Q=RA
DBR=DBR-2
GO TO 1400
402 RJX=RJX+RA
C HEAVIER BAR LINES
CALL LINES(RJX,OLDY,2)
J7=J7-1
OLDY=RW
IF(RJ.LT.0)OLDY=RX
RJ=-RJ
GO TO 406
C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
1401 CALL HBRACK
GO TO 2401
C DASHES
401 POS=POS-RST18
IF(J7.LE.0)GO TO 407
IF(J7.EQ.4)GO TO 1401
IF(J7.NE.3)GO TO 4001
C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
2401 JA=3
IF(J10.EQ.0)J10=6.*DIS*RSTJ2
C THICKNESS FOLLOWS PLOTTER SIZE AND STAFF SIZE
C DEFAULT VALUE FOR THICKNESS =6*SIZE FACTS.
R4=R4-RBR
J9=0
J5=35
C THE NUM FOR THE LITTLE END ITEMS
R6=3
R7=0
C DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
R8=0
C R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
JZ8=J8
C SAVE J8 IN JZ8 (J8 WIPED OUT IN CLEFS)
IF(J8.NE.2)CALL CLEFS
C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
R4=R5-RBR
R6=3
R7=-3
C TURNS IT UPSIDE DOWN.
IF(J7.NE.4)GO TO 3401
POS=RA
R4=R4*RJY/RSTJ2
C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
3401 IF(JZ8.NE.1)CALL CLEFS
C JZ8 IS CURRENTLY J8 (INTEGER I.E.)
R3Q=R3Q-12.0*RSTJ2
IF(J7.NE.4)GO TO 407
J7=0
GO TO 140
4001 IF(J7.NE.5)GO TO 4002
CALL CBRACK
RETURN
4002 CALL DASHLN
RETURN
407 RX=RD+POS
OLDY=R5*RST7+POS
R8=ABS(R8)
C NO NEG, TOLERATED!!! 2/78
IF(J7.EQ.3)GO TO 140
CALL NOZERO(R9)
IF(J7.EQ.-1)GO TO 408
C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
RJX=IFIX(ROFF(RHORZ(R6)))
C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
IF(J7.EQ.0)GO TO 42
OLDY=R9*RST7+RX
CALL NOZERO(R8)
4041 RZ=RX
RH=OLDY
C SAVE FOR THICK WIGGLES
CALL LINES(R3Q,RX,3)
C DRAWS STRAIGHT LINES. ETC.
R9=R3Q
RJ=OLDY
RW=3.*RSTJ2*R8
RA=RW*2.5
C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
404 R9=R9+RA
CALL LINES(R9,RJ,2)
R9=R9+RW
CALL LINES(R9,RJ,2)
405 CALL EXCH(RX,RJ)
IF(R9.LT.RJX)GO TO 404
IF(J10.LE.0)RETURN
OLDY=XDIS
RX=RZ+OLDY
OLDY=RH+OLDY
J10=J10-1
GO TO 4041
C P10= + NUM OF THICKNESSES TO WIGGLE
408 IF(RX.GT.OLDY)CALL EXCH(RX,OLDY)
RZ=R9*RSTJ2*5.96
C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
CALL NOZERO(R8)
RD=R8*RST7*.5
RJ=RD
IF(RD.LT.1.)RD=1.
421 R9=RX
RW=R3Q
RA=RZ+R3Q
CALL LINES(RW,R9,3)
410 R9=R9+RJ
CALL LINES(RA,R9,2)
R9=R9+RD
CALL LINES(RA,R9,2)
CALL EXCH(RA,RW)
IF(R9.LT.OLDY)GO TO 410
IF(J10.LE.0)RETURN
R3Q=R3Q+XDIS
J10=J10-1
GO TO 421
C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
END
SUBROUTINE DASHLN
IMPLICIT INTEGER(A-Q,S-Z)
REAL POS,XDIS,OLDY
COMMON/STF/RSTFAC(0/7),RSTJ2
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
EQUIVALENCE (J3,JQ(1)),(R5,RJQ(3)),(R11,
1RJQ(9)),(R6,RJQ(4)),(J10,JQ(8))
1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
1 ,(R4,RJQ(2)),(RX3,RJQ(20))
4002 IF(R8.LE.0)R8=.8
C NO NEG. NUMBS!!!! 2/78
C P8 CAN SET SIZE OF DASH
RZ=5.96*RSTJ2
RJ=R8*RZ
RZ=R9*RZ
IF(R9.LE.0)RZ=RJ
C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
R8=RJ
R9=RZ
RD=RD+POS
RJX=RD
RJY=RD
C =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
J6=ROFF(RHORZ(R6))
J3=J6-J3
RJ4=R5-R4
RA=J6
C SAVE FOR THICK LINES
C RA IS HORIZ. GOAL FOR DASHES
OLDY=POS+R5*RST7
IF(RJ4.EQ.0)GO TO 41
RH=OLDY-RD
C TOTAL HEIGHT DIFF.
RX=RA-R3
C TOTAL LENGTH DIFF.
RH=RH/RX
41 L=3
K=2
416 CALL LINES(R3Q,RD,L)
IF(J3.EQ.0)GO TO 412
C JUMP FOR VERT. DASH
IF(J3.GT.0)GO TO 422
IF(R3Q.LE.RA)GO TO 413
C THIS IF P6 IS LESS THAN P3
R3Q=R3Q-RJ
GO TO 423
422 IF(R3Q.GE.RA)GO TO 413
C JUMP IF ALL DONE
R3Q=R3Q+RJ
423 IF(RJ4.NE.0)RD=RJY+RH*(R3Q-R3)
C RJ4 HAS TILT
C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
414 CALL EXCH(L,K)
CALL EXCH(RJ,RZ)
C EXCH. SPACE AND DASH SIZE.
GO TO 416
412 IF(RJ4.GT.0)GO TO 424
IF(RD.LE.OLDY)GO TO 413
RD=RD-RJ
C THIS IF P5 IS LESS THAN P4.
GO TO 414
424 IF(RD.GE.OLDY)GO TO 413
C JUMP IF DONE
RD=RD+RJ
GO TO 414
413 IF(J10.GT.0)GO TO 420
IF(J11.EQ.0)RETURN
IF(J3)RJ=-RJ
IF(L.EQ.3)R3Q=R3Q-RJ
RX=R8
IF(J11.LT.0)RX=-RX
CALL LINX(R3Q,RD,R3Q,RD+RX)
C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
RETURN
C NEXT FOR THICK DASHES
420 J10=J10-1
RJ=XDIS
IF(J3.EQ.0)GO TO 415
R3Q=R3
RJY=RJY+RJ
RD=RJY
GO TO 417
415 R3Q=R3Q+RJ
RD=RJX
417 RJ=R8
RZ=R9
C FOR THICK DASHES.
GO TO 41